<%
'######################################################################
'## ab.e.sp.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Special Encryption
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/06/10 22:30
'## Description :   AspBox Special Encryption Block
'## ====================
'## 不支持中文及特殊字符
'######################################################################

Class Cls_AB_E_SP

	Private sDefaultWHEEL1,sDefaultWHEEL2
	Private s_pass

	Private Sub Class_Initialize()
		'sDefaultWHEEL1 = "ABCDEFGHIJKLMNOPQRSTVUWXYZ_1234567890qwertyuiopasd!@#$%^&*(),.~`-=\?/’""<>;fghjklzxcvbnm"
		sDefaultWHEEL1 = "ABCDEFGHIJKLMNOPQRSTVUWXYZ1234567890abcdefghijklmnopqrstuvwxyz"

		'sDefaultWHEEL2 = "IWEHJKTLZVOPFG_1234567890qwerBNMQRYUASDXCfghjklzxc~`-=\?/’""!@#$%^&*(),.<>;vbnmtyuiopasd"
		sDefaultWHEEL2 = "ABCDEFGHIJKLMNOPQRSTVUWXYZ1234567890abcdefghijklmnopqrstuvwxyz"
		
		s_pass = "AspBoxEncrypt" '定义密匙
	End Sub

	Private Sub Class_Terminate()

	End Sub

	'-------------------------------------------------------------------------
	' @ 设置加密解密密钥，全局参数，读写
	'-------------------------------------------------------------------------
	' Desc: 设置密钥
	' e.g. AB.E.SP.Password = "AspBoxEncrypt"
	'-------------------------------------------------------------------------

	Public Property Let Password(ByVal p)
		If (Not IsNull(p)) and p<>"" Then s_pass = p
	End Property

	Public Property Get Password()
		Password = s_pass
	End Property

	'@ ***********************************************************************
	'@ 过程名:  AB.E.SP.E(str) {简写为：AB.E.SP(str) }
	'@ 返  回:  加密后的字符串
	'@ 作  用:  对字符串进行加密
	'==Param==================================================================
	'@ str  : 待加密的字符串 # [String]
	'==DEMO===================================================================
	'@ AB.E.SP.Password = "AspBoxEncrypt"
	'@ AB.C.Print AB.E.SP.E("aspbox") 
	'@ 返回值：aql6gn
	'@ ***********************************************************************

	Public Default Function E(ByVal s)
		E = Encrypt_SP(s)
	End Function

	'@ ***********************************************************************
	'@ 过程名:  AB.E.SP.D(str)
	'@ 返  回:  对由加密的字符串进行解密还原
	'@ 作  用:  解密加密后的字符串
	'==Param==================================================================
	'@ str  : 待加密的字符串 # [String]
	'==DEMO===================================================================
	'@ AB.C.Print AB.E.SP.D(AB.E.SP.E("aspbox")) '返回值: aspbox
	'@ ***********************************************************************

	Public Function D(ByVal s)
		D = Decrypt_SP(s)
	End Function

	Public Property Let sTemp1(ByVal p)
		If (Not IsNull(p)) and p<>"" Then sDefaultWHEEL1 = p
	End Property

	Public Property Let sTemp2(ByVal p)
		If (Not IsNull(p)) and p<>"" Then sDefaultWHEEL2 = p
	End Property

	Private Function Encrypt_SP(Byval sINPUT)
		On Error Resume Next
		Dim sWHEEL1, sWHEEL2
		Dim k, c, i
		Dim sRESULT
		sWHEEL1 = sDefaultWHEEL1: sWHEEL2 = sDefaultWHEEL2
		ScrambleWheels sWHEEL1, sWHEEL2, s_pass
		sRESULT = ""
		For i = 1 To Len(sINPUT)
			c = Mid(sINPUT, i, 1)
			k = InStr(1, sWHEEL1, c)
			If k > 0 Then
				sRESULT = sRESULT & Mid(sWHEEL2, k, 1)
			Else
				sRESULT = sRESULT & Addpass(c,s_pass)
			End If
			sWHEEL1 = LeftShift(sWHEEL1): sWHEEL2 = RightShift(sWHEEL2)
		Next
		Encrypt_SP = sRESULT
		On Error Goto 0
	End Function

	Private Function Decrypt_SP(Byval sINPUT)
		On Error Resume Next
		Dim sWHEEL1, sWHEEL2
		Dim k, i, c
		Dim sRESULT
		sWHEEL1 = sDefaultWHEEL1: sWHEEL2 = sDefaultWHEEL2
		ScrambleWheels sWHEEL1, sWHEEL2, s_pass
		sRESULT = ""
		For i = 1 To Len(sINPUT)
			c = Mid(sINPUT, i, 1)
			k = InStr(1, sWHEEL2, c, vbBinaryCompare)
			If k > 0 Then
				sRESULT = sRESULT & Mid(sWHEEL1, k, 1)
			Else
				sRESULT = sRESULT & Addpass(c,s_pass)
			End If
			sWHEEL1 = LeftShift(sWHEEL1): sWHEEL2 = RightShift(sWHEEL2)
		Next
		Decrypt_SP = sRESULT
		On Error Goto 0
	End Function

	Private Function LeftShift(s )
		If Len(s) > 0 Then LeftShift = Mid(s, 2, Len(s) - 1) & Mid(s, 1, 1)
	End Function

	Private Function RightShift(s )
		If Len(s) > 0 Then RightShift = Mid(s, Len(s), 1) & Mid(s, 1, Len(s) - 1)
	End Function

	Private Sub ScrambleWheels(ByRef sW1 , ByRef sW2)
		Dim i ,k
		For i = 1 To Len(s_pass)
			For k = 1 To Asc(Mid(s_pass, i, 1)) * i
				sW1 = LeftShift(sW1): sW2 = RightShift(sW2)
			Next
		Next
	End Sub

	Private Function Addpass(tStr,tPass)
		Select Case tStr
		Case Chr(13)
		Addpass = tStr
		Case Chr(10)
		Addpass = tStr
		Case Chr(13)+Chr(10)
		Addpass = tStr
		Case Chr(9)
		Addpass = tStr
		Case Else
		Addpass = Chr((Asc(tPass) Xor Len(tPass)) Xor Asc(tStr))
		End Select
	End Function

End Class
%>